home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / harvest.cpt / Harvest C / Tcl 6.2 / tclCkalloc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-29  |  15.0 KB  |  533 lines
  1. #ifdef macintosh
  2. #    pragma segment tclCkalloc
  3. #endif
  4.  
  5. /* 
  6.  * tclCkalloc.c --
  7.  *    Interface to malloc and free that provides support for debugging problems
  8.  *    involving overwritten, double freeing memory and loss of memory.
  9.  *
  10.  * Copyright 1991 Regents of the University of California
  11.  * Permission to use, copy, modify, and distribute this
  12.  * software and its documentation for any purpose and without
  13.  * fee is hereby granted, provided that the above copyright
  14.  * notice appear in all copies.  The University of California
  15.  * makes no representations about the suitability of this
  16.  * software for any purpose.  It is provided "as is" without
  17.  * express or implied warranty.
  18.  *
  19.  * This code contributed by Karl Lehenbauer and Mark Diekhans
  20.  *
  21.  */
  22.  
  23. #include "tclInt.h"
  24.  
  25. #define FALSE    0
  26. #define TRUE    1
  27.  
  28. #ifdef TCL_MEM_DEBUG
  29. #include "tclUnix.h"
  30.  
  31. #define GUARD_SIZE 8
  32.  
  33. struct mem_header {
  34.         long               length;
  35.         char              *file;
  36.         int                line;
  37.         struct mem_header *flink;
  38.         struct mem_header *blink;
  39.         unsigned char      low_guard[GUARD_SIZE];
  40.         char               body[1];
  41. };
  42.  
  43. static struct mem_header *allocHead = NULL;  /* List of allocated structures */
  44.  
  45. #define GUARD_VALUE  0341
  46.  
  47. /* static char high_guard[] = {0x89, 0xab, 0xcd, 0xef}; */
  48.  
  49. static int total_mallocs = 0;
  50. static int total_frees = 0;
  51. static int current_bytes_malloced = 0;
  52. static int maximum_bytes_malloced = 0;
  53. static int current_malloc_packets = 0;
  54. static int maximum_malloc_packets = 0;
  55. static int break_on_malloc = 0;
  56. static int trace_on_at_malloc = 0;
  57. static int  alloc_tracing = FALSE;
  58. static int  init_malloced_bodies = FALSE;
  59. #ifdef MEM_VALIDATE
  60.     static int  validate_memory = TRUE;
  61. #else
  62.     static int  validate_memory = FALSE;
  63. #endif
  64.  
  65.  
  66. /*
  67.  *----------------------------------------------------------------------
  68.  *
  69.  * dump_memory_info --
  70.  *     Display the global memory management statistics.
  71.  *
  72.  *----------------------------------------------------------------------
  73.  */
  74. static void
  75. dump_memory_info(outFile) 
  76.     FILE *outFile;
  77. {
  78.         fprintf(outFile,"total mallocs             %10d\n", 
  79.                 total_mallocs);
  80.         fprintf(outFile,"total frees               %10d\n", 
  81.                 total_frees);
  82.         fprintf(outFile,"current packets allocated %10d\n", 
  83.                 current_malloc_packets);
  84.         fprintf(outFile,"current bytes allocated   %10d\n", 
  85.                 current_bytes_malloced);
  86.         fprintf(outFile,"maximum packets allocated %10d\n", 
  87.                 maximum_malloc_packets);
  88.         fprintf(outFile,"maximum bytes allocated   %10d\n", 
  89.                 maximum_bytes_malloced);
  90. }
  91.  
  92. /*
  93.  *----------------------------------------------------------------------
  94.  *
  95.  * ValidateMemory --
  96.  *     Procedure to validate allocted memory guard zones.
  97.  *
  98.  *----------------------------------------------------------------------
  99.  */
  100. static void
  101. ValidateMemory (memHeaderP, file, line, nukeGuards)
  102.     struct mem_header *memHeaderP;
  103.     char              *file;
  104.     int                line;
  105.     int                nukeGuards;
  106. {
  107.     unsigned char *hiPtr;
  108.     int   idx;
  109.     int   guard_failed = FALSE;
  110.  
  111.     for (idx = 0; idx < GUARD_SIZE; idx++)
  112.         if (*(memHeaderP->low_guard + idx) != GUARD_VALUE) {
  113.             guard_failed = TRUE;
  114.             fflush (stdout);
  115.             fprintf(stderr, "low guard byte %d is 0x%x\n", idx, 
  116.                     *(memHeaderP->low_guard + idx) & 0xff);
  117.         }
  118.  
  119.     if (guard_failed) {
  120.         dump_memory_info (stderr);
  121.         fprintf (stderr, "low guard failed at %lx, %s %d\n",
  122.                  memHeaderP->body, file, line);
  123.         fflush (stderr);  /* In case name pointer is bad. */
  124.         fprintf (stderr, "Allocated at (%s %d)\n", memHeaderP->file,
  125.                  memHeaderP->line);
  126.         panic ("Memory validation failure");
  127.     }
  128.  
  129.     hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
  130.     for (idx = 0; idx < GUARD_SIZE; idx++)
  131.         if (*(hiPtr + idx) != GUARD_VALUE) {
  132.             guard_failed = TRUE;
  133.             fflush (stdout);
  134.             fprintf(stderr, "hi guard byte %d is 0x%x\n", idx, 
  135.                     *(hiPtr+idx) & 0xff);
  136.         }
  137.  
  138.     if (guard_failed) {
  139.         dump_memory_info (stderr);
  140.         fprintf (stderr, "high guard failed at %lx, %s %d\n",
  141.                  memHeaderP->body, file, line);
  142.         fflush (stderr);  /* In case name pointer is bad. */
  143.         fprintf (stderr, "Allocated at (%s %d)\n", memHeaderP->file,
  144.                  memHeaderP->line);
  145.         panic ("Memory validation failure");
  146.     }
  147.  
  148.     if (nukeGuards) {
  149.         memset ((char *) memHeaderP->low_guard, 0, GUARD_SIZE); 
  150.         memset ((char *) hiPtr, 0, GUARD_SIZE); 
  151.     }
  152.  
  153. }
  154.  
  155. /*
  156.  *----------------------------------------------------------------------
  157.  *
  158.  * Tcl_ValidateAllMemory --
  159.  *     Validates guard regions for all allocated memory.
  160.  *
  161.  *----------------------------------------------------------------------
  162.  */
  163. void
  164. Tcl_ValidateAllMemory (file, line)
  165.     char  *file;
  166.     int    line;
  167. {
  168.     struct mem_header *memScanP;
  169.  
  170.     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
  171.         ValidateMemory (memScanP, file, line, FALSE);
  172.  
  173. }
  174.  
  175. /*
  176.  *----------------------------------------------------------------------
  177.  *
  178.  * Tcl_DumpActiveMemory --
  179.  *     Displays all allocated memory to stderr.
  180.  *
  181.  * Results:
  182.  *     Return TCL_ERROR if an error accessing the file occures, `errno' 
  183.  *     will have the file error number left in it.
  184.  *----------------------------------------------------------------------
  185.  */
  186. int
  187. Tcl_DumpActiveMemory (fileName)
  188.     char *fileName;
  189. {
  190.     FILE              *fileP;
  191.     struct mem_header *memScanP;
  192.     char              *address;
  193.  
  194.     fileP = fopen (fileName, "w");
  195.     if (fileP == NULL)
  196.         return TCL_ERROR;
  197.  
  198.     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
  199.         address = &memScanP->body [0];
  200.         fprintf (fileP, "%8lx - %8lx  %7d @ %s %d\n", address,
  201.                  address + memScanP->length - 1, memScanP->length,
  202.                  memScanP->file, memScanP->line);
  203.     }
  204.     fclose (fileP);
  205.     return TCL_OK;
  206. }
  207.  
  208. /*
  209.  *----------------------------------------------------------------------
  210.  *
  211.  * Tcl_DbCkalloc - debugging ckalloc
  212.  *
  213.  *        Allocate the requested amount of space plus some extra for
  214.  *        guard bands at both ends of the request, plus a size, panicing 
  215.  *        if there isn't enough space, then write in the guard bands
  216.  *        and return the address of the space in the middle that the
  217.  *        user asked for.
  218.  *
  219.  *        The second and third arguments are file and line, these contain
  220.  *        the filename and line number corresponding to the caller.
  221.  *        These are sent by the ckalloc macro; it uses the preprocessor
  222.  *        autodefines __FILE__ and __LINE__.
  223.  *
  224.  *----------------------------------------------------------------------
  225.  */
  226. char *
  227. Tcl_DbCkalloc(size, file, line)
  228.     unsigned int size;
  229.     char        *file;
  230.     int          line;
  231. {
  232.     struct mem_header *result;
  233.  
  234.     if (validate_memory)
  235.         Tcl_ValidateAllMemory (file, line);
  236.  
  237.     result = (struct mem_header *)malloc((unsigned)size + 
  238.                               sizeof(struct mem_header) + GUARD_SIZE);
  239.     if (result == NULL) {
  240.         fflush(stdout);
  241.         dump_memory_info(stderr);
  242.         panic("unable to alloc %d bytes, %s line %d", size, file, 
  243.               line);
  244.     }
  245.  
  246.     /*
  247.      * Fill in guard zones and size.  Link into allocated list.
  248.      */
  249.     result->length = size;
  250.     result->file = file;
  251.     result->line = line;
  252.     memset ((char *) result->low_guard, GUARD_VALUE, GUARD_SIZE);
  253.     memset (result->body + size, GUARD_VALUE, GUARD_SIZE);
  254.     result->flink = allocHead;
  255.     result->blink = NULL;
  256.     if (allocHead != NULL)
  257.         allocHead->blink = result;
  258.     allocHead = result;
  259.  
  260.     total_mallocs++;
  261.     if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
  262.         (void) fflush(stdout);
  263.         fprintf(stderr, "reached malloc trace enable point (%d)\n",
  264.                 total_mallocs);
  265.         fflush(stderr);
  266.         alloc_tracing = TRUE;
  267.         trace_on_at_malloc = 0;
  268.     }
  269.  
  270.     if (alloc_tracing)
  271.         fprintf(stderr,"ckalloc %lx %d %s %d\n", result->body, size, 
  272.                 file, line);
  273.  
  274.     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
  275.         break_on_malloc = 0;
  276.         (void) fflush(stdout);
  277.         fprintf(stderr,"reached malloc break limit (%d)\n", 
  278.                 total_mallocs);
  279.         fprintf(stderr, "program will now enter C debugger\n");
  280.         (void) fflush(stderr);
  281.         kill (getpid(), SIGINT);
  282.     }
  283.  
  284.     current_malloc_packets++;
  285.     if (current_malloc_packets > maximum_malloc_packets)
  286.         maximum_malloc_packets = current_malloc_packets;
  287.     current_bytes_malloced += size;
  288.     if (current_bytes_malloced > maximum_bytes_malloced)
  289.         maximum_bytes_malloced = current_bytes_malloced;
  290.  
  291.     if (init_malloced_bodies)
  292.         memset (result->body, 0xff, (int) size);
  293.  
  294.     return result->body;
  295. }
  296.  
  297. /*
  298.  *----------------------------------------------------------------------
  299.  *
  300.  * Tcl_DbCkfree - debugging ckfree
  301.  *
  302.  *        Verify that the low and high guards are intact, and if so
  303.  *        then free the buffer else panic.
  304.  *
  305.  *        The guards are erased after being checked to catch duplicate
  306.  *        frees.
  307.  *
  308.  *        The second and third arguments are file and line, these contain
  309.  *        the filename and line number corresponding to the caller.
  310.  *        These are sent by the ckfree macro; it uses the preprocessor
  311.  *        autodefines __FILE__ and __LINE__.
  312.  *
  313.  *----------------------------------------------------------------------
  314.  */
  315.  
  316. int
  317. Tcl_DbCkfree(ptr, file, line)
  318.     char *  ptr;
  319.     char     *file;
  320.     int       line;
  321. {
  322.     struct mem_header *memp = 0;  /* Must be zero for size calc */
  323.  
  324.     /*
  325.      * Since header ptr is zero, body offset will be size
  326.      */
  327.     memp = (struct mem_header *)(((char *) ptr) - (int)memp->body);
  328.  
  329.     if (alloc_tracing)
  330.         fprintf(stderr, "ckfree %lx %ld %s %d\n", memp->body, 
  331.                 memp->length, file, line);
  332.  
  333.     if (validate_memory)
  334.         Tcl_ValidateAllMemory (file, line);
  335.  
  336.     ValidateMemory (memp, file, line, TRUE);
  337.  
  338.     total_frees++;
  339.     current_malloc_packets--;
  340.     current_bytes_malloced -= memp->length;
  341.  
  342.     /*
  343.      * Delink from allocated list
  344.      */
  345.     if (memp->flink != NULL)
  346.         memp->flink->blink = memp->blink;
  347.     if (memp->blink != NULL)
  348.         memp->blink->flink = memp->flink;
  349.     if (allocHead == memp)
  350.         allocHead = memp->flink;
  351.     free((char *) memp);
  352.     return 0;
  353. }
  354.  
  355. /*
  356.  *----------------------------------------------------------------------
  357.  *
  358.  * MemoryCmd --
  359.  *     Implements the TCL memory command:
  360.  *       memory info
  361.  *       memory display
  362.  *       break_on_malloc count
  363.  *       trace_on_at_malloc count
  364.  *       trace on|off
  365.  *       validate on|off
  366.  *
  367.  * Results:
  368.  *     Standard TCL results.
  369.  *
  370.  *----------------------------------------------------------------------
  371.  */
  372.     /* ARGSUSED */
  373. static int
  374. MemoryCmd (clientData, interp, argc, argv)
  375.     char       *clientData;
  376.     Tcl_Interp *interp;
  377.     int         argc;
  378.     char      **argv;
  379. {
  380.     char *fileName;
  381.  
  382.     if (argc < 2) {
  383.     Tcl_AppendResult(interp, "wrong # args:  should be \"",
  384.         argv[0], " option [args..]\"", (char *) NULL);
  385.     return TCL_ERROR;
  386.     }
  387.  
  388.     if (strcmp(argv[1],"trace") == 0) {
  389.         if (argc != 3) 
  390.             goto bad_suboption;
  391.         alloc_tracing = (strcmp(argv[2],"on") == 0);
  392.         return TCL_OK;
  393.     }
  394.     if (strcmp(argv[1],"init") == 0) {
  395.         if (argc != 3)
  396.             goto bad_suboption;
  397.         init_malloced_bodies = (strcmp(argv[2],"on") == 0);
  398.         return TCL_OK;
  399.     }
  400.     if (strcmp(argv[1],"validate") == 0) {
  401.         if (argc != 3)
  402.              goto bad_suboption;
  403.         validate_memory = (strcmp(argv[2],"on") == 0);
  404.         return TCL_OK;
  405.     }
  406.     if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
  407.         if (argc != 3) 
  408.             goto argError;
  409.         if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK)
  410.                 return TCL_ERROR;
  411.          return TCL_OK;
  412.     }
  413.     if (strcmp(argv[1],"break_on_malloc") == 0) {
  414.         if (argc != 3) 
  415.             goto argError;
  416.         if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK)
  417.                 return TCL_ERROR;
  418.         return TCL_OK;
  419.     }
  420.  
  421.     if (strcmp(argv[1],"info") == 0) {
  422.         dump_memory_info(stdout);
  423.         return TCL_OK;
  424.     }
  425.     if (strcmp(argv[1],"active") == 0) {
  426.         if (argc != 3) {
  427.         Tcl_AppendResult(interp, "wrong # args:  should be \"",
  428.             argv[0], " active file", (char *) NULL);
  429.         return TCL_ERROR;
  430.     }
  431.         fileName = argv [2];
  432.         if (fileName [0] == '~')
  433.             if ((fileName = Tcl_TildeSubst (interp, fileName)) == NULL)
  434.                 return TCL_ERROR;
  435.         if (Tcl_DumpActiveMemory (fileName) != TCL_OK) {
  436.         Tcl_AppendResult(interp, "error accessing ", argv[2], 
  437.             (char *) NULL);
  438.         return TCL_ERROR;
  439.     }
  440.     return TCL_OK;
  441.     }
  442.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  443.         "\":  should be info, init, active, break_on_malloc, ",
  444.         "trace_on_at_malloc, trace, or validate", (char *) NULL);
  445.     return TCL_ERROR;
  446.  
  447. argError:
  448.     Tcl_AppendResult(interp, "wrong # args:  should be \"", argv[0],
  449.         " ", argv[1], "count\"", (char *) NULL);
  450.     return TCL_ERROR;
  451.  
  452. bad_suboption:
  453.     Tcl_AppendResult(interp, "wrong # args:  should be \"", argv[0],
  454.         " ", argv[1], " on|off\"", (char *) NULL);
  455.     return TCL_ERROR;
  456. }
  457.  
  458. /*
  459.  *----------------------------------------------------------------------
  460.  *
  461.  * Tcl_InitMemory --
  462.  *     Initialize the memory command.
  463.  *
  464.  *----------------------------------------------------------------------
  465.  */
  466. void
  467. Tcl_InitMemory(interp)
  468.     Tcl_Interp *interp;
  469. {
  470. Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData)NULL, 
  471.                   (void (*)())NULL);
  472. }
  473.  
  474. #else
  475.  
  476.  
  477. /*
  478.  *----------------------------------------------------------------------
  479.  *
  480.  * Tcl_Ckalloc --
  481.  *     Interface to malloc when TCL_MEM_DEBUG is disabled.  It does check
  482.  *     that memory was actually allocated.
  483.  *
  484.  *----------------------------------------------------------------------
  485.  */
  486. VOID *
  487. Tcl_Ckalloc (size)
  488.     unsigned int size;
  489. {
  490.         char *result;
  491.  
  492.         result = malloc(size);
  493.         if (result == NULL) 
  494.                 panic("unable to alloc %d bytes", size);
  495.         return result;
  496. }
  497.  
  498. /*
  499.  *----------------------------------------------------------------------
  500.  *
  501.  * TckCkfree --
  502.  *     Interface to free when TCL_MEM_DEBUG is disabled.  Done here rather
  503.  *     in the macro to keep some modules from being compiled with 
  504.  *     TCL_MEM_DEBUG enabled and some with it disabled.
  505.  *
  506.  *----------------------------------------------------------------------
  507.  */
  508. void
  509. Tcl_Ckfree (ptr)
  510.     VOID *ptr;
  511. {
  512.         free (ptr);
  513. }
  514.  
  515. /*
  516.  *----------------------------------------------------------------------
  517.  *
  518.  * Tcl_InitMemory --
  519.  *     Dummy initialization for memory command, which is only available 
  520.  *     if TCL_MEM_DEBUG is on.
  521.  *
  522.  *----------------------------------------------------------------------
  523.  */
  524.     /* ARGSUSED */
  525. void
  526. Tcl_InitMemory(interp)
  527.     Tcl_Interp *interp;
  528. {
  529. }
  530.  
  531. #endif
  532.  
  533.